﻿{%MainUnit extFileUtils.pas}
{
 extUtils
 --------
 Additional various routine which not yet available and/or not yet fixed on Lazarus v1.0.x
 
 This Unit is Part of GauExtUtils Package Component for Lazarus.
 Code name Package		: H-Băng
 Branch name Package	: Anh Giờ Đây
  Last Updated 			: 3:53 AM 16/12/2013 (GMT+07)

 Copyright (c) 2012 - 2013, Takeda Matsuki and others
 License : Modified LGPL (follow Lazarus license). 
}

function extCopyFile(const SrcFilename, DestFilename: StrCtrl;
                  Flags: TCopyFileFlagsExt=[cffOverwriteFile]): Boolean;
var
  SrcFS: TFileStreamUTF8;
  DestFS: TFileStreamUTF8;
begin
  Result := False;
  SrcFS := TFileStreamUTF8.Create(SrcFilename, fmOpenRead or fmShareDenyWrite);
  try
    if (not (cffOverwriteFile in Flags)) and FileExistsUTF8(DestFileName) then
      exit;
    if (cffCreateDestDirectory in Flags)
    and (not DirectoryExistsUTF8(ExtractFilePath(DestFileName)))
    and (not ForceDirectoriesUTF8(ExtractFilePath(DestFileName))) then
      exit;
    DestFS := TFileStreamUTF8.Create(DestFilename, fmCreate);
    try
      DestFS.CopyFrom(SrcFS, SrcFS.Size);
    finally
      DestFS.Free;
    end;
    if (cffPreserveTime in Flags) then
      extFileSetDateUTF8(DestFilename, FileGetDate(SrcFS.Handle));
    Result := True;
  finally
    SrcFS.Free;
  end;
end;

function extCopyFile(const SrcFilename, DestFilename: StrCtrl; PreserveTime: Boolean): boolean;
// Flags parameter can be used for the same thing.
var
  Flags: TCopyFileFlagsExt;
begin
  if PreserveTime then
    Flags:=[cffPreserveTime, cffOverwriteFile]
  else
    Flags:=[cffOverwriteFile];
  Result := extCopyFile(SrcFilename, DestFilename, Flags);
end;

{ TCopyDirTree implementation }

procedure TCopyDirTreeExt.DoFileFound;
var
  NewLoc: StrCtrl;
begin
  // ToDo: make sure StringReplace works in all situations !
  NewLoc:=StringReplace(FileName, FSourceDir, FTargetDir, []);

  if not extCopyFile(FileName, NewLoc, FFlags) then
    Inc(FCopyFailedCount);
end;

procedure TCopyDirTreeExt.DoDirectoryFound;
var
  NewPath:StrCtrl;
begin
  NewPath:=StringReplace(FileName, FSourceDir, FTargetDir, []);
  // ToDo: make directories also respect cffPreserveTime flag.
  if not FileUtil.DirectoryExistsUTF8(NewPath) then
    if not FileUtil.ForceDirectoriesUTF8(NewPath) then
      Inc(FCopyFailedCount);
end;

function extCopyDirTree(const SourceDir, TargetDir: StrCtrl; Flags: TCopyFileFlagsExt=[]): Boolean;
var
  Searcher: TCopyDirTreeExt;
begin
  Result:=False;
  Searcher:=TCopyDirTreeExt.Create;
  try
    Flags:=Flags-[cffCreateDestDirectory];
    Searcher.FFlags:=Flags;
    Searcher.FCopyFailedCount:=0;
    Searcher.FSourceDir:=SourceDir;
    Searcher.FTargetDir:=TargetDir;
    Searcher.Search(SourceDir, GetAllFilesMask, True);
    Result:=True;
  finally
    Result:=Searcher.FCopyFailedCount=0;
    Searcher.Free;
  end;
end;

function extDeleteDirectory(const DirectoryName: StrCtrl; OnlyChildren, RemoveReadOnlyFiles : boolean): boolean;
const
 ExtRules=faAnyFile {$ifdef unix} or faSymLink {$endif unix};
var
  FileInfo: TSearchRec;
  CurSrcDir: StrCtrl;
  CurFilename: StrCtrl;
begin
  Result:=false;
  CurSrcDir:=CleanAndExpandDirectory(DirectoryName);
  if FindFirstUTF8(CurSrcDir+GetAllFilesMask,ExtRules,FileInfo)=0 then begin
    repeat
      // check if special file
      if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then
        continue;
      CurFilename:=CurSrcDir+FileInfo.Name;
	  
      if RemoveReadOnlyFiles and ((FileInfo.Attr and faReadOnly)>0) then
        if (FileSetAttrUTF8(CurFilename, FileInfo.Attr-faReadOnly)<>0) then exit;

      if (((FileInfo.Attr and faDirectory)>0) {$ifdef unix} and ((FileInfo.Attr and faSymLink)=0) {$endif unix}) then
         if not extDeleteDirectory(CurFilename,false, RemoveReadOnlyFiles) then exit
      else
      begin
        if not DeleteFileUTF8(CurFilename) then exit;
      end;
    until FindNextUTF8(FileInfo)<>0;
  end;
  FindCloseUTF8(FileInfo);
  if (not OnlyChildren) and (not RemoveDirUTF8(DirectoryName)) then exit;
  Result:=true;
end;

function extFileSearchUTF8(const Name, DirList: StrCtrl; ImplicitCurrentDir : Boolean = True): StrCtrl;
Var
  I : longint;
  Temp : StrCtrl;

begin
  Result:=Name;
  temp:=SetDirSeparators(DirList);
  // Start with checking the file in the current directory
  If ImplicitCurrentDir and (Result <> '') and FileExistsUTF8(Result) Then
    exit;
  while True do begin
    If Temp = '' then
      Break; // No more directories to search - fail
    I:=UTF8Pos(PathSeparator,Temp);
    If I<>0 then
      begin
        Result:=UTF8Copy(Temp,1,i-1);
        system.Delete(Temp,1,I);
      end
    else
      begin
        Result:=Temp;
        Temp:='';
      end;
    If Result<>'' then
      Result:=IncludeTrailingPathDelimiter(Result)+name;
    If (Result <> '') and FileExistsUTF8(Result) Then
      exit;
  end;
  Result:='';
end;

function extReadFileToStringUTF8(const Filename: StrCtrl): StrCtrl;
var
  fs: TFileStreamUTF8;
begin
  Result := '';
  try
    fs := TFileStreamUTF8.Create(Filename, fmOpenRead or fmShareDenyWrite);
    try
      Setlength(Result, fs.Size);
      if Result <> '' then
        fs.Read(Result[1], UTF8Length(Result));
    finally
      fs.Free;
    end;
  except
    Result := '';
  end;
end;

function extExtractFileDirU(const FileName: StrCtrl): StrCtrl;
var
  i : longint;
  EndSeparator : Set of Char;
begin
  I := Length(UTF8Encode(FileName));
  EndSeparator:=AllowDirectorySeparators+AllowDriveSeparators;
  while (I > 0) and not (FileName[I] in EndSeparator) do
    Dec(I);
  if (I > 1) and (FileName[I] in AllowDirectorySeparators) and
     not (FileName[I - 1] in EndSeparator) then
    Dec(I);
  Result := UTF8Decode(Copy(FileName, 1, I));
end; 

function extExtractFilePathU(const FileName: StrCtrl): StrCtrl;
var
  i : longint;
  EndSeparator : Set of Char;
begin
  i := Length(UTF8Encode(FileName));
  EndSeparator:=AllowDirectorySeparators+AllowDriveSeparators;
  while (i > 0) and not (FileName[i] in EndSeparator) do
    Dec(i);
  If I>0 then
    Result := UTF8Decode(Copy(FileName, 1, i))
  else
    Result:='';
end;      

function extGetCurSelfFullNamePathU : StrCtrl;
var
 Temp:StrCtrl;
begin
 Temp:=ParamStrUTF8(0);
 Result:=extGetCurDirUTF8 + {$IFDEF WINDOWS} '\' {$ELSE} '/' {$ENDIF} + extExtractFileNameU(Temp);
end;

function extStringReplaceU(const S, OldPattern, NewPattern: StrCtrl;  Flags: TReplaceFlags): StrCtrl;
var
  Srch,OldP,RemS: UTF8String; // Encoded as "CP_UTF8".
  P : Integer;
begin
  Srch:=S;
  OldP:=OldPattern;
  if rfIgnoreCase in Flags then
    begin
    Srch:=UTF8UpperCase(Srch);
    OldP:=UTF8UpperCase(OldP);
    end;
  RemS:=S;
  Result:='';
  while (UTF8Length(Srch)<>0) do
    begin
    P:=UTF8Pos(OldP, Srch);
    if P=0 then
      begin
      Result:=Result+RemS;
      Srch:='';
      end
    else
      begin
      Result:=Result+Copy(RemS,1,P-1)+NewPattern;
      P:=P+UTF8Length(OldP);
      RemS:=Copy(RemS,P,UTF8Length(RemS)-P+1);
      if not (rfReplaceAll in Flags) then
        begin
        Result:=Result+RemS;
        Srch:='';
        end
      else
         Srch:=Copy(Srch,P,UTF8Length(Srch)-P+1);
      end;
    end;
end;

function extFileIsText(const AFilename: StrCtrl): boolean;
var
  FileReadable, TempStatus: Boolean;
begin
  // File must could be readable before we judging "Yes It's text" : 20130128-Res01
  TempStatus:=extFileIsText(AFilename,FileReadable);
  if ((TempStatus) and (FileReadable)) then 
   Result:=True
  else
   Result:=False;
end;           

function extFileIsText(const AFilename: StrCtrl; out FileReadable: boolean): boolean;
const
  BufLen = 1024;
var
  fs: TFileStreamUTF8;
  Buf: StrCtrl;
  Len: integer;
  NewLine: boolean;
  p: PChar;
  ZeroAllowed: Boolean;
begin
  Result:=false;
  FileReadable:=true;
  try
    fs := TFileStreamUTF8.Create(AFilename, fmOpenRead or fmShareDenyNone);
    try
      // read the first 1024 bytes
      Len:=BufLen;
      SetLength(Buf,BufLen+1);
      Len:=fs.Read(Buf[1],BufLen);
      if Len>0 then begin
        Buf[Len+1]:=#0;
        p:=PChar(Buf);
        ZeroAllowed:=false;
        if (p[0]=#$EF) and (p[1]=#$BB) and (p[2]=#$BF) then begin
          // UTF-8 BOM (Byte Order Mark)
          inc(p,3);
        end else if (p[0]=#$FF) and (p[1]=#$FE) then begin
          // ucs-2le BOM FF FE
          inc(p,2);
          ZeroAllowed:=true;
        end else if (p[0]=#$FE) and (p[1]=#$FF) then begin
          // ucs-2be BOM FE FF
          inc(p,2);
          ZeroAllowed:=true;
        end;
        NewLine:=false;
        while true do begin
          case p^ of
          #0:
            if p-PChar(Buf)>=Len then
              break
            else if not ZeroAllowed then
              exit;
          // #10,#13: new line
          // #12: form feed
          // #26: end of file
          #1..#8,#11,#14..#25,#27..#31: exit;
          #10,#13: NewLine:=true;
          end;
          inc(p);
        end;
        if NewLine or (Len<1024) then
          Result:=true;
      end else
        Result:=true;
    finally
      fs.Free;
    end;
  except
    on E: Exception do begin
      FileReadable:=false;
    end;
  end;
end; 

function extDirectoryIsWritable(const DirectoryName: StrCtrl): boolean;
var
  TempFilename: StrCtrl;
  fs: TFileStreamUTF8;
  s: StrCtrl;
begin
  TempFilename:=FileUtil.GetTempFilename(DirectoryName,'tstperm');
  Result:=false;
  try
    fs:=TFileStreamUTF8.Create(TempFilename,fmCreate);
    s:='WriteTest';
    fs.Write(s[1],length(s));
    fs.Free;
    DeleteFileUTF8(TempFilename);
    Result:=true;
  except
  end;
end;

function extIsDirectoryEmpty(const Directory : StrCtrl) : boolean;
var
  Seeker :TSearchRec;
  CurDir:StrCtrl;
begin
  CurDir:=CleanAndExpandDirectory(Directory);
  try
   Result := (FindFirstUTF8(CurDir + GetAllFilesMask, faAnyFile, Seeker) = 0) AND
             (FindNextUTF8(Seeker) = 0) AND
             (FindNextUTF8(Seeker) <> 0) ;
  finally
    FindCloseUTF8(Seeker) ;
  end;
end;

function extRenameDirUTF8(const OldName, NewName:StrCtrl):Boolean;
var
 TempDir, TempDir2:StrCtrl;
begin
 // Alternative -> for some unknown reason, RenameFileUTF8 was failed to be used
 // Renaming the Directory. So We must to make sure the target was exactly
 // formatted as Directory to prevent "Error" and "Corrupt", especially on MacOS.
 TempDir:=CleanAndExpandDirectory(OldName);
 TempDir2:=CleanAndExpandDirectory(NewName);

 if not FileUtil.DirectoryExistsUTF8(TempDir) then
  begin
    Result:=False;
    Exit;
  end
 else
  Result:=RenameFileUTF8(TempDir, TempDir2);
end; 

function extMultipleRenameFilesUTF8(const NewName : StrCtrl; FilesList : TStrings):Boolean;
var
 i, CountFailed : Integer;
begin
 CountFailed:=0;

 for i:=0 to FilesList.Count-1 do
  begin
   if not FileUtil.FileExistsUTF8(FilesList.Strings[i]) and
      not RenameFileUTF8(FilesList.Strings[i], NewName) then
       CountFailed:=+1;
  end;

 if CountFailed > 0 then Result:=False
 else Result:=True;

end;         

function extMultipleRenameDirUTF8(const NewName : StrCtrl; DirList : TStrings):Boolean;
var
 i, CountFailed : Integer;
begin
 CountFailed:=0;

 for i:=0 to DirList.Count-1 do
  begin
   if not FileUtil.DirectoryExistsUTF8(DirList.Strings[i]) and
      not extRenameDirUTF8(DirList.Strings[i], NewName) then
       CountFailed:=+1;
  end;

 if CountFailed > 0 then Result:=False
 else Result:=True;

end;

function extGetFileNameStartPos(const AFileName:StrCtrl):Integer;
var
  StartPos: Integer;
begin
  StartPos:=length(AFilename)+1;

  while (StartPos>1)
  and (AFilename[StartPos-1]<>PathDelim)
  {$IFDEF Windows}and (AFilename[StartPos-1]<>':'){$ENDIF}
  do
    dec(StartPos);

  Result:=StartPos;
end;

function extGetFileNameExtPos(const AFileName:StrCtrl):Integer;
var
  StartPos: Integer;
  ExtPos: Integer;
begin
  ExtPos:=length(AFilename);
  StartPos:=extGetFileNameStartPos(AFileName);

  while (ExtPos>=StartPos) and (AFilename[ExtPos]<>'.') do
    dec(ExtPos);

  if (ExtPos<StartPos) then ExtPos:=length(AFilename)+1;

  Result:=ExtPos;
end; 

function extExtractFileExt(const AFileName:StrCtrl):StrCtrl;
var
  StartPos: Integer;
  ExtPos: Integer;
begin
  StartPos:=extGetFileNameStartPos(AFileName);
  ExtPos:=extGetFileNameExtPos(AFileName);

  Result:=Copy(AFilename,ExtPos,ExtPos-StartPos);
end;

function extExtractFileNameU(const Filename: StrCtrl): StrCtrl;
var
  StartPos: Integer;
  ExtPos: Integer;
begin
  StartPos:=extGetFileNameStartPos(FileName);
  ExtPos:=extGetFileNameExtPos(FileName);

  Result:=Copy(Filename,StartPos,ExtPos);
end;
